home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / HUMBOLT / HUMBOLTS / _files / _humboltsr / PROLOG._c < prev    next >
Text File  |  1990-12-08  |  11KB  |  407 lines
  1. /***************************************************
  2. ****************************************************
  3. **                                                **
  4. **  HU-Prolog     Portable Interpreter System     **
  5. **                                                **
  6. **  Release 1.62   January  1990                  **
  7. **                                                **
  8. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  9. **                                                **
  10. **  (C) 1989      Humboldt-University             **
  11. **                Department of Mathematics       **
  12. **                GDR 1086 Berlin, P.O.Box 1297   **
  13. **                                                **
  14. ****************************************************
  15. ***************************************************/
  16.  
  17. #include <stdlib.h>
  18. #include <setjmp.h>
  19.  
  20. #include "systems.h"
  21. #include "types.h"
  22. #include "errors.h"
  23. #include "atoms.h"
  24. #include "files.h"
  25. #include "manager.h"
  26.  
  27. IMPORT void InitIO();                   /* from basicio.c */
  28. IMPORT void InitAtoms();                /* from atomtable.c */
  29. IMPORT void InitMemory();               /* from memory.c */
  30. IMPORT void InitDatabase();             /* from database.c */
  31. IMPORT void InitdynMem();                  /* from memory.c */
  32. IMPORT void InitAll();
  33. #if WINDOWS
  34. IMPORT void w_init();
  35. #endif
  36. #if USER
  37. IMPORT void InitUser();                  /* from usereval.c   */
  38. #endif
  39.  
  40. IMPORT void retractclauses();            /* from retract.c */
  41. IMPORT TERM READIN();                    /* from readin.c */
  42. IMPORT int VARCOUNT;                     /* from readin.c */
  43. IMPORT int IOERRORFLAG;
  44. IMPORT int ERRORFLAG;
  45. IMPORT ENV NEWENV();                    /* from unify.c */
  46. IMPORT void KILLSTACKS();               
  47. IMPORT void ABORT(),SYSTEMERROR();      /* from linebufffer.c */
  48. IMPORT file OpenFile();                 /* from files.c */
  49. IMPORT boolean FileExist();
  50. IMPORT void FileError();
  51. IMPORT ENV TRACE_GOON;                   /* from writeout.c */
  52. IMPORT TERM A0,A2;                       /* from evalpreds.c     */
  53. IMPORT TERM CALLX;                       /* from eval.c */
  54. IMPORT ATOM LOOKUP();
  55. IMPORT void exit();
  56. IMPORT string s_gotoxy();
  57. IMPORT TERM mk2sons(),VARTERM(),
  58.             phy_name(), stackterms();
  59. IMPORT ATOM copyatom();
  60. IMPORT CLAUSE ADDCLAUSE();
  61. IMPORT boolean EXECUTE();
  62. #if REALARITH
  63. IMPORT boolean FpAbort;                  /* from arith.c         */
  64. #endif
  65.  
  66. /* Variable declarations */
  67.  
  68. GLOBAL PHASE  MODE;
  69. LOCAL boolean RST;
  70.  
  71. #if INITFILE
  72. GLOBAL string RESTORESTATE=RESFILE;
  73. #endif
  74. LOCAL string PROLIB= (string)0;
  75.  
  76. ENV  E,CHOICEPOINT;
  77. TERM BE;
  78. GLOBAL int ARGC;
  79. GLOBAL char **ARGV;
  80. int SPYING=0;            /* count spypoints */
  81. boolean  HALTFLAG=false, 
  82.          TRACING=false, 
  83.          SPYTRACE=false,
  84.          ECHOFLAG=false,
  85.          DEBUGFLAG=false,
  86.          OCHECK  =false,  
  87.          WARNFLAG=true,
  88.          ENAB_INTR=true,
  89.          EVENT=false,
  90.          xWINDOW_ON=false,
  91.          UserAbort=false,
  92.          aSYSMODE=false,
  93.          REDUCEFLAG=true,
  94.          VERBOSE=true,
  95.          BOOTING=false,
  96.          In_Toplevel_Read=false;
  97.  
  98.  
  99.  
  100.  
  101.  
  102. /* encapsulation of jump to global labels 100,101,999 */
  103.  
  104. jmp_buf error_label;  /* used also in evalpreds.c */ 
  105. jmp_buf abort_label;
  106. LOCAL globaladdr=0;
  107.  
  108. GLOBAL int RETURN_CODE=0;
  109.  
  110. GLOBAL void ERRORJMP (void)
  111. {
  112.   longjmp(error_label,1); 
  113. }
  114.  
  115. GLOBAL void LONG_JMP(int I)
  116. {
  117.   longjmp(abort_label,I);
  118. }
  119.  
  120. #if !CPM
  121. #include <signal.h>
  122. LOCAL void sig_handler(int s)
  123. {
  124.   switch(s) {
  125. #if REALARITH && VMS
  126.   case SIGFPE:
  127.          signal(FPEXCEPTE,sig_handler);
  128.          FpAbort=true;break;
  129. #endif
  130.   case SIGINT:
  131.          signal(SIGINT,sig_handler);
  132.          EVENT=true; UserAbort=true; 
  133.   if(MODE!=USERM) LONG_JMP(999);  
  134.   break;
  135. #if UNIX || VMS
  136.   case SIGQUIT: LONG_JMP(999);
  137. #endif
  138.   }
  139. }
  140. #endif
  141.  
  142. /*
  143.    Read and execute clauses from the current file. 
  144. */
  145.  
  146. LOCAL TERM MAKETOPLEVEL(TERM X)
  147. { TERM Y;
  148.     if(name(X)==COMMA_2)
  149.     { 
  150.         X=son(X); 
  151.         return mk2sons(name(X),son(X),GOTO_1, MAKETOPLEVEL(br(X)));
  152.     }
  153.     else if(non_nil_term(Y=VARTERM())) 
  154.             return mk2sons(name(X),son(X),GOTO_1,Y);
  155.     else return mk2sons(name(X),son(X),nil_atom,nil_term);
  156. } 
  157.  
  158. ENV TOPENV;  
  159.  
  160. LOCAL void TOPLEVEL (PHASE MO, boolean init)
  161. { TERM  X;
  162.   CLAUSE MCL;
  163.   ATOM filename;
  164.   ATOM LAST_ASS_ATOM=nil_atom;
  165.   MODE=MO;
  166.   HALTFLAG=false;
  167.   TRACE_GOON=0;
  168.   switch (MO)
  169.   { case SYSM:  filename=LOOKUP(PROLIB,0,true); break;
  170.     case USERM: filename=STDIN_0; break;
  171.   }
  172.   if((inputfile=OpenFile(phy_name(filename),read_mode)) < 0)
  173.   {
  174.         FLOGNAME(inputfile)=STDIN_0;
  175.         if(MODE==USERM) inputfile=STDIN;
  176.         else {CALLX=phy_name(filename);FileError(CANTOP);ABORT(0);}
  177.   }
  178.   else 
  179.       FLOGNAME(inputfile)=copyatom(filename);
  180.   if((outputfile=OpenFile(phy_name(STDOUT_0),write_mode)) < 0)
  181.         if(MODE==USERM) outputfile=STDOUT;
  182.         else {CALLX=phy_name(STDOUT_0);FileError(CANTOP);ABORT(0);}
  183.   FLOGNAME(outputfile)=STDOUT_0;
  184.   do
  185.   {
  186.     retractclauses();
  187.     TOPENV=CHOICEPOINT=E=NEWENV(0); BE=base(E);
  188.     
  189.     if (init && non_nil_clause(clause(INIT_0))) 
  190.       { EXECUTE(mkfunc(CALL_1,mkatom(INIT_0)),E); init=0; }
  191.     else
  192.     if(MODE==USERM)
  193.       if(non_nil_clause(clause(TOP_0))) 
  194.         EXECUTE(mkfunc(CALL_1,mkatom(TOP_0)),E);
  195.       else 
  196.         { if(VERBOSE)
  197.             if (non_nil_clause(clause(PROMPT_0)))
  198.              { EXECUTE(mkfunc(CALL_1,mkatom(PROMPT_0)),E);
  199.                KILLSTACKS(TOPENV);
  200.                TOPENV=CHOICEPOINT=E=NEWENV(0); BE=base(E);
  201.              }
  202.             else ws("?-");
  203.           In_Toplevel_Read=true;X=READIN();In_Toplevel_Read=false; 
  204.           clause(MAIN_0)=MCL=stackterms(5);
  205.           name(MCL)=CLAUSET; name(br(MCL))=INTT;
  206.           nextcl(MCL)=nil_clause; setnvars(MCL,VARCOUNT);
  207.           name(head(MCL))=MAIN_0; son(head(MCL))=nil_term;
  208.           name(body(MCL))=GOTO_1; son(body(MCL))=MAKETOPLEVEL(X);
  209.           if(EXECUTE(mkatom(MAIN_0),E)) {if(VERBOSE)ws("\nyes\n");}
  210.           else if(VERBOSE)ws("\nno\n");
  211.         }
  212.     else { 
  213.            if(!ECHOFLAG && VERBOSE && MODE!=SYSM)ws("."); 
  214.            X=READIN();
  215.            if(name(X)==END_0) HALTFLAG=true;
  216.            else if(name(X)==QUESTION_1 || name(X)==ARROW_1)
  217.            {
  218.                 LAST_ASS_ATOM=nil_atom;
  219.                 if(!EXECUTE(mkfunc(CALL_1,son(X)),E) &&
  220.                    name(X)!=ARROW_1 && WARNFLAG)
  221.                     ws("WARNING: goal failed during consult/reconsult");
  222.            }
  223.            else 
  224.            {    /* assertz(X) */ 
  225.                 register ATOM A;
  226.                 register CLAUSE CL,CX;
  227.                 
  228.                 if((A=name(X))==ARROW_2) A=name(arg1(X));
  229.                 if((system(A) && !aSYSMODE) || class(A)!=NORMP)
  230.                     ABORT(SYSPROCE);
  231.                 A=copyatom(A);
  232.                 if(non_nil_clause(CL=clause(A)))
  233.                 {   while(non_nil_clause(CX=nextcl(CL))) CL=CX;
  234.                     nextcl(CL)=CX=ADDCLAUSE(X);
  235.                     if(WARNFLAG && LAST_ASS_ATOM !=A)
  236.                     {
  237.                         ws("WARNING: new clauses for ");
  238.                         wq(A);ws("/");wi(arity(A));
  239.                         ws("\n");
  240.                     }
  241.  
  242.                 }
  243.                 else clause(A)=CX=ADDCLAUSE(X);
  244.                 nextcl(CX)=nil_clause;
  245.  
  246.                 LAST_ASS_ATOM=A;
  247.            }
  248.          }
  249.     KILLSTACKS(TOPENV);
  250.     if(MODE==USERM) IOERRORFLAG=0; 
  251.     if(UserAbort && ENAB_INTR) ABORT(ABORTE);
  252.   }
  253.   while(!HALTFLAG);
  254. }
  255.  
  256. LOCAL void InitArg(int argc, char *argv[])
  257. {int i;
  258.  for(i=1;i<argc;i++)
  259.    if (argv[i][0]=='-') {
  260.      if( i < argc-1 )
  261.         switch(argv[i][1]) {
  262.           case 'l' : case 'L' : PROLIB=argv[++i];break;
  263. #if INITFILE
  264.           case 'r' : case 'R' : RESTORESTATE=argv[++i];break;
  265. #endif
  266. #ifdef DYNMEM
  267.           case 'a' : case 'A' : MAX_ATOMS=atoi(argv[++i]);break;
  268.           case 't' : case 'T' : MAX_TERMS=atoi(argv[++i]);break;
  269.           case 'c' : case 'C' : MAX_TRAILER=atoi(argv[++i]);break;
  270.           case 'g' : case 'G' : MAX_ENVS=atoi(argv[++i]);break;
  271.           case 's' : case 'S' : MAX_STRINGS=atoi(argv[++i]);break;
  272. #endif
  273.        }
  274.  
  275.      switch(argv[i][1])
  276.        { case 'B' : if (argv[i][2]=='O' && argv[i][3]=='O' && 
  277.                       argv[i][4]=='T' && argv[i][5]==0) 
  278.                   BOOTING=true; break;
  279.          case 'v' : case 'V' : VERBOSE=false;break;
  280.        }
  281.    }
  282.      
  283. }
  284.  
  285. #ifdef OYSTER
  286. LOCAL string RCNAME=OYSTERRC;
  287. #else
  288. LOCAL string RCNAME=PROLOGRC;
  289. #endif
  290.  
  291. LOCAL void rcfile(void)
  292. {
  293.     string S,A,I;
  294.     extern char *getenv();                       /* from clib */
  295.     static char AA[100];
  296.     A="";
  297. #if RISCOS
  298.     S=getenv( "HUPro$RC" );
  299.     if( S == 0 )
  300.        S = RCNAME;
  301.     if(FileExist(S))
  302.       A = S;
  303. #else
  304.     if(FileExist(RCNAME)) A=RCNAME; 
  305. #if UNIX 
  306.     else
  307.       { A=AA;
  308.         S=getenv("HOME");I=A; while(*S) *I++= *S++;
  309.         if(*(--S) != '/') *I++= '/';
  310.         S=RCNAME; while(*S) *I++= *S++;
  311.         *I= '\0';
  312.         if(!FileExist(A)) return ;
  313.       }
  314. #endif
  315. #endif
  316.   if(!PROLIB && *A)PROLIB=A;
  317.   return ; 
  318. }
  319.  
  320. #ifdef OYSTER
  321. LOCAL string Copyright="\nOyster-2 Programming System 0.7 24/04/90\n\n";
  322. #else
  323. LOCAL string Copyright="\nHU-Prolog Copright (c) 1990 C.Horn, M.Dziadzka, M.Horn\nRISC-OS VERSION 1.1\n\n";
  324. #endif
  325.  
  326. GLOBAL void DOVERSION(void)
  327. { ws(Copyright); 
  328. }
  329.  
  330. int main(int argc, char *argv[])
  331. { 
  332.   int first_time=0;
  333.   ARGC=argc;
  334.   ARGV=argv;
  335.   InitArg(argc,argv);
  336. #ifdef DYNMEM
  337.   InitdynMem();
  338. #endif
  339.   if (!BOOTING && first_time==0) InitAll();
  340.   if (BOOTING) InitMemory(); 
  341. #if  BIC
  342.   Init_Irm();
  343. #endif
  344. #if WINDOWS
  345.   if(xWINDOW_ON)w_init();
  346. #endif
  347. #if !CPM
  348.   if (!BOOTING) rcfile();
  349. #endif
  350.   if( !PROLIB) PROLIB= "\0";
  351.  
  352.   /* Initialising Interrupt Handling */
  353. #if !CPM
  354.   signal(SIGINT,sig_handler);     /* user interrupt */
  355. #if UNIX || VMS
  356.   signal(SIGQUIT,sig_handler);    /* kill process */
  357. #endif
  358. #if VMS && REALARITH
  359.   signal(SIGFPE,sig_handler);     /* floating point exception */
  360. #endif
  361. #endif
  362.  
  363.   globaladdr=setjmp(abort_label);
  364.   InitIO();
  365.   ERRORFLAG=0;
  366.   (void)setjmp(error_label);
  367.   if(ERRORFLAG) ABORT(ERRORFLAG);
  368.   UserAbort=false;
  369.  
  370.   if( VERBOSE ) ws(Copyright); 
  371.  
  372.   if(RST)goto l101;
  373.   EVENT=SPYTRACE;
  374.   if(globaladdr==100) goto l100;
  375.   if(globaladdr==101) goto l101;
  376.   if(globaladdr==999) goto l999;
  377.   if (BOOTING)
  378.   { 
  379. #if USER
  380.     InitUser(0);
  381. #endif
  382.     InitAtoms(); 
  383.     InitDatabase(); 
  384. #if USER
  385.     InitUser(1);
  386. #endif
  387.   }
  388.  
  389.      aSYSMODE=true;
  390.      if(*PROLIB) TOPLEVEL(SYSM,0);
  391.   l100:
  392.      aSYSMODE=false;
  393.   l101:
  394.      globaladdr=101; 
  395.      if(first_time++==0) TOPLEVEL(USERM,1); 
  396.      else TOPLEVEL(USERM,0);
  397.   l999:
  398.      outputfile=STDOUT;
  399. #if WINDOWS
  400.      if(xWINDOW_ON)w_exit();
  401. #endif
  402.   exit(RETURN_CODE);
  403.   /*NOTREACHED*/
  404. }
  405.  
  406.  
  407.